Imports System.ComponentModel<DefaultEvent("时间调整")> _Public Class 可调时钟 Private CenterPoint As New Point(128, 128) Private B As Bitmap = Nothing Private _秒 As Bitmap = Nothing Private _时 As Bitmap = Nothing Private _分 As Bitmap = Nothing Private Dt As Date = Now Private _SelLayer As Integer = 0 Private _PM As Boolean = False Public Event 时间调整(Dt As Date) Private PMRct As New Rectangle(99, 85, 60, 25) Private Sub 可调时钟_Load(sender As Object, e As EventArgs) Handles MyBase.Load MakeBg() End Sub Private Sub MakeBg() Try If Me.Created = False Then Exit Sub Dim Rg As New Region B = Nothing B = New Bitmap(255, 255) Dim Lst As Single() = GetAng(Dt) Using G As Graphics = Graphics.FromImage(B) G.Clip = New Region(New Rectangle(0, 0, 255, 255)) If _PM = False Then G.DrawImage(My.Resources.time1, New Rectangle(0, 0, 255, 255), New Rectangle(0, 0, 255, 255), GraphicsUnit.Pixel) Else G.DrawImage(My.Resources.time2, New Rectangle(0, 0, 255, 255), New Rectangle(0, 0, 255, 255), GraphicsUnit.Pixel) End If G.TranslateTransform(CenterPoint.X, CenterPoint.Y) G.RotateTransform(Lst(0)) Make_秒(Lst(0)) G.DrawImage(My.Resources.秒针, New Rectangle(-5, -100, 10, 130), New Rectangle(0, 0, 10, 130), GraphicsUnit.Pixel) G.ResetTransform() G.TranslateTransform(CenterPoint.X, CenterPoint.Y) G.RotateTransform(Lst(1)) Make_分(Lst(1)) G.DrawImage(My.Resources.分针, New Rectangle(-7, -90, 11, 100), New Rectangle(0, 0, 11, 100), GraphicsUnit.Pixel) G.ResetTransform() G.TranslateTransform(CenterPoint.X, CenterPoint.Y) G.RotateTransform(Lst(2)) Make_时(Lst(2)) G.DrawImage(My.Resources.时针, New Rectangle(-11, -55, 23, 67), New Rectangle(0, 0, 23, 67), GraphicsUnit.Pixel) G.ResetTransform() End Using Me.BackgroundImage = B Catch End Try End Sub Private Sub Make_秒(Ang As Single) Try _秒 = Nothing _秒 = New Bitmap(255, 255) Using G As Graphics = Graphics.FromImage(_秒) G.Clip = New Region(New Rectangle(0, 0, 255, 255)) G.TranslateTransform(CenterPoint.X, CenterPoint.Y) G.RotateTransform(Ang) G.DrawImage(My.Resources.秒针, New Rectangle(-5, -100, 10, 130), New Rectangle(0, 0, 10, 130), GraphicsUnit.Pixel) End Using 'DSAPI.图形图像.图像特效.色彩.亮度(_秒, 128) Catch End Try End Sub Private Sub Make_分(Ang As Single) Try _分 = Nothing _分 = New Bitmap(255, 255) Using G As Graphics = Graphics.FromImage(_分) G.Clip = New Region(New Rectangle(0, 0, 255, 255)) G.TranslateTransform(CenterPoint.X, CenterPoint.Y) G.RotateTransform(Ang) G.DrawImage(My.Resources.分针, New Rectangle(-7, -90, 11, 100), New Rectangle(0, 0, 11, 100), GraphicsUnit.Pixel) End Using 'DSAPI.图形图像.图像特效.色彩.亮度(_分, 128) Catch End Try End Sub Private Sub Make_时(Ang As Single) Try _时 = Nothing _时 = New Bitmap(255, 255) Using G As Graphics = Graphics.FromImage(_时) G.Clip = New Region(New Rectangle(0, 0, 255, 255)) G.TranslateTransform(CenterPoint.X, CenterPoint.Y) G.RotateTransform(Ang) G.DrawImage(My.Resources.时针, New Rectangle(-11, -55, 23, 67), New Rectangle(0, 0, 23, 67), GraphicsUnit.Pixel) 'DSAPI.图形图像.图像特效.色彩.亮度(_时, 128) End Using Catch End Try End Sub Private Function GetAng(Tm As Date) As Single() Dim Lst As New List(Of Single) Lst.Add(0) '秒 Lst.Add(0) '分 Lst.Add(0) '时 Try Lst(0) = 360 / 60 * Tm.Second Lst(1) = 360 / 60 * Tm.Minute 6 / 60 * Tm.Second Dim H As Integer = Tm.Hour If H > 11 Then H -= 12 Lst(2) = 360 / 12 * Tm.Hour 30 / 60 * Tm.Minute Catch End Try Return Lst.ToArray End Function Private Sub 可调时钟_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick If e.Button = Windows.Forms.MouseButtons.Left Then If PMRct.Contains(e.Location) Then _PM = Not _PM Dim H As Integer = Dt.Hour If _PM = True Then H = 12 If H > 23 Then H = 23 Else H -= 12 If H < 0 Then H = 0 End If Dt = New Date(Dt.Year, Dt.Month, Dt.Day, H, Dt.Minute, Dt.Second) MakeBg() RaiseEvent 时间调整(Dt) End If End If End Sub Private Sub 可调时钟_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown If e.Button = Windows.Forms.MouseButtons.Left Then If e.X >= 0 AndAlso e.Y >= 0 AndAlso e.X <= 255 AndAlso e.Y <= 255 Then Dim IsCatched As Boolean = False If IsCatched = False AndAlso _时.GetPixel(e.X, e.Y).A > 10 Then _SelLayer = 1 IsCatched = True End If If IsCatched = False AndAlso _分.GetPixel(e.X, e.Y).A > 10 Then _SelLayer = 2 IsCatched = True End If If IsCatched = False AndAlso _秒.GetPixel(e.X, e.Y).A > 10 Then _SelLayer = 3 IsCatched = True End If If IsCatched Then Cursor = Cursors.Hand MakeBg() Else _SelLayer = 0 Cursor = Cursors.Default End If End If End If End Sub Private Sub 可调时钟_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove If e.X >= 0 AndAlso e.Y >= 0 AndAlso e.X <= 255 AndAlso e.Y <= 255 Then If _时.GetPixel(e.X, e.Y).A > 10 OrElse _分.GetPixel(e.X, e.Y).A > 10 OrElse _秒.GetPixel(e.X, e.Y).A > 10 Then Cursor = Cursors.Hand Else If PMRct.Contains(e.Location) Then Cursor = Cursors.Hand Else Cursor = Cursors.Default End If End If Else Exit Sub End If If _SelLayer = 0 Then Exit Sub If e.Button = Windows.Forms.MouseButtons.Left Then Dim H As Integer = 0 Try Select Case _SelLayer Case 1 H = 11 / 360 * GetAng(e.Location) If _PM = True Then H = 12 If H > 23 Then H = 23 End If Dt = New Date(Dt.Year, Dt.Month, Dt.Day, H, Dt.Minute, Dt.Second) Case 2 H = 59 / 360 * GetAng(e.Location) Dt = New Date(Dt.Year, Dt.Month, Dt.Day, Dt.Hour, H, Dt.Second) Case 3 H = 59 / 360 * GetAng(e.Location) Dt = New Date(Dt.Year, Dt.Month, Dt.Day, Dt.Hour, Dt.Minute, H) End Select MakeBg() Catch End Try RaiseEvent 时间调整(Dt) End If End Sub Private Function GetAng(Pt As Point) As Double '斜边=Math.Sqrt(A ^ 2 B ^ 2) '夹角=90 - (Math.Asin(A / 斜边) / Math.PI * 180) Dim H As Double = 0 Dim Pt1 As New Point(Pt.X - Me.Width / 2, Pt.Y - Me.Height / 2) H = Math.Sqrt(Pt1.X ^ 2 Pt1.Y ^ 2) If Pt1.X < 0 AndAlso Pt1.Y < 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180) H = 270 End If If Pt1.X > 0 AndAlso Pt1.Y > 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180) H = 90 End If If Pt1.X < 0 AndAlso Pt1.Y > 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180) H = 180 End If If Pt1.X > 0 AndAlso Pt1.Y < 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180) End If If Pt1.X = 0 AndAlso Pt1.Y > 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180) End If If Pt1.X = 0 AndAlso Pt1.Y < 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180) End If If Pt1.X < 0 AndAlso Pt1.Y = 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180) End If If Pt1.X > 0 AndAlso Pt1.Y = 0 Then H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180) End If If H > 360 Then H = 360 Return H End Function Private Sub 可调时钟_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp _SelLayer = 0 End SubEnd Class
评论